home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / cmln1085.arc / FRACTALS.PAS < prev    next >
Pascal/Delphi Source File  |  1986-02-27  |  2KB  |  90 lines
  1. {$u+ }
  2. program fractals;
  3. { Modified Greg Turk's fractals program from BYTE, Sept. 1984 }
  4.  
  5. type  complex = record  x,y  : real  end;
  6.  
  7. var   cx, cy, i : integer;
  8.       z, lambda : complex;
  9.          sc     : real;
  10.  
  11. {   Include here the files needed to interface to GSX }
  12. {$iB:GSXWORK.INC}
  13. {$iB:GSXLINE.INC}
  14.  
  15. procedure z_times_l;
  16. var  tx,ty  : real;
  17. begin   with z do begin
  18.             tx := x;  ty := y;
  19.             x := tx * lambda.x - ty * lambda.y;
  20.             y := tx * lambda.y + ty * lambda.x
  21.         end
  22. end;
  23.  
  24. procedure sqrt_of_z;
  25. var   t,s  : real;
  26. begin  with z do begin
  27.          t := y;
  28.          s := sqrt(sqr(x) + sqr(y));
  29.          y := sqrt((s-x+0.00001)/2.0 );
  30.          x := sqrt((s+x+0.00001)/2.0);
  31.          if t<0 then x := -x
  32.       end
  33. end;
  34.  
  35. procedure function_of_z;
  36. begin   z_times_l;
  37.         with z do begin
  38.            x := 1.0 - x;
  39.            sqrt_of_z;
  40.            if random < 0.5 then begin  x := -x;  y := -y  end;
  41.            x := 1.0 - x;
  42.            x := x/2.0 ;  y := y/2.0
  43.         end
  44. end;
  45.  
  46. procedure four_over_l;
  47. var   s: real;
  48. begin    with lambda do begin
  49.           s := sqr(x) + sqr(y);
  50.           x := 4.0 * x / s;
  51.           y := -4.0 * y / s
  52.          end
  53. end;
  54.  
  55. procedure getvalues;
  56. begin   with lambda do begin
  57.           write('What is lambda? x,y ');
  58.           readln(x,y);  writeln(x,y);
  59.           four_over_l
  60.         end;
  61.         write('What is scale? ');
  62.         readln(sc); writeln(sc);
  63.         sc := 2.0 * cx / sc
  64. end;
  65.  
  66. procedure plotz;
  67. var    point : array[1..4] of integer;
  68.  
  69. begin  point[1] := trunc( sc * (z.x - 0.5) + cx);
  70.        point[2] := trunc(cy - sc *  z.y);
  71.        point[3] := point[1];    point[4] := point[2];
  72.        {writeln(point[1],' ',point[2]);}
  73.        polyline(2,addr(point))
  74. end;
  75.  
  76. {********************** main ***********************}
  77.  
  78. begin cx := 32767 div 2;  cy := cx;     z.x:=0.50001; z.y:= 0.0;
  79.       randomize;
  80.       getvalues;
  81.       writeln('Enter workstation number (1,2,21)> ');readln(i);
  82.       openworkstation(i);
  83.       for i:= 1 to 10 do function_of_z;
  84.      while not keypressed do begin
  85.          function_of_z;
  86.          plotz
  87.      end;
  88.      updatestation;
  89.      closestation
  90. end.